home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / perl / usub / pager < prev   
Encoding:
Text File  |  1990-08-13  |  4.5 KB  |  210 lines
  1. #!./curseperl
  2.  
  3. eval <<'EndOfMain';   $evaloffset = 3;    # line number of this line
  4.  
  5.     $| = 1;        # command buffering on stdout
  6.     &initterm;
  7.     &inithelp;
  8.     &slurpfile && &pagearray;
  9.  
  10. EndOfMain
  11.  
  12. &endwin;
  13.  
  14. if ($@) {
  15.     print "";        # force flush of stdout
  16.     $@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e;
  17.     die $@;
  18. }
  19.  
  20. exit;
  21.  
  22. ################################################################################
  23.  
  24. sub initterm {
  25.  
  26.     &initscr; &cbreak; &noecho; &scrollok($stdscr, 1);
  27.     &defbell unless defined &bell;
  28.  
  29.     $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2;
  30.     $cols = $COLS;   $cols1  = $cols  - 1; $cols2  = $cols  - 2;;
  31.  
  32.     $dl = &getcap('dl');
  33.     $al = &getcap('al');
  34.     $ho = &getcap('ho');
  35.     $ce = &getcap('ce');
  36. }
  37.  
  38. sub slurpfile {
  39.     while (<>) {
  40.     s/^(\t+)/'        ' x length($1)/e;
  41.     &expand($_) if /\t/;
  42.     if (length($_) < $cols) {
  43.         push(@lines, $_);
  44.     }
  45.     else {
  46.         while ($_ && $_ ne "\n") {
  47.         push(@lines, substr($_,0,$cols));
  48.         substr($_,0,$cols) = '';
  49.         }
  50.     }
  51.     }
  52.     1;
  53. }
  54.  
  55. sub drawscreen {
  56.     &move(0,0);
  57.     for ($line .. $line + $lines2) {
  58.     &addstr($lines[$_]);
  59.     }
  60.     &clrtobot;
  61.     &percent;
  62.     &refresh;
  63. }
  64.  
  65. sub expand {
  66.     while (($off = index($_[0],"\t")) >= 0) {
  67.     substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
  68.     }
  69. }
  70.  
  71. sub pagearray {
  72.     $line = 0;
  73.  
  74.     $| = 1;
  75.  
  76.     for (&drawscreen;;&drawscreen) {
  77.  
  78.     $ch = &getch;
  79.     $ch = "j" if $ch eq "\n";
  80.  
  81.     if ($ch eq ' ') {
  82.         last if $percent >= 100;
  83.         &move(0,0);
  84.         $line += $lines1;
  85.     }
  86.     elsif ($ch eq 'b') {
  87.         $line -= $lines1;
  88.         &move(0,0);
  89.         $line = 0 if $line < 0;
  90.     }
  91.     elsif ($ch eq "j") {
  92.         $line += 1;
  93.         if ($dl) {
  94.         print $ho, $dl;
  95.         &mvcur(0,0,$lines2,0);
  96.         print $ce,$lines[$line+$lines2],$ce;
  97.         &wmove($curscr,0,0);
  98.         &wdeleteln($curscr);
  99.         &wmove($curscr,$lines2,0);
  100.         &waddstr($curscr,$lines[$line+$lines2]);
  101.         }
  102.         &wmove($stdscr,0,0);
  103.         &wdeleteln($stdscr);
  104.         &wmove($stdscr,$lines2,0);
  105.         &waddstr($stdscr,$lines[$line+$lines2]);
  106.         &percent;
  107.         &refresh;
  108.         redo;
  109.     }
  110.     elsif ($ch eq "k") {
  111.         next if $line <= 0;
  112.         $line -= 1;
  113.         if ($al) {
  114.         print $ho, $al, $ce, $lines[$line];
  115.         &wmove($curscr,0,0);
  116.         &winsertln($curscr);
  117.         &waddstr($curscr,$lines[$line]);
  118.         }
  119.         &wmove($stdscr,0,0);
  120.         &winsertln($stdscr);
  121.         &waddstr($stdscr,$lines[$line]);
  122.         &percent;
  123.         &refresh;
  124.         redo;
  125.     }
  126.     elsif ($ch eq "\f") {
  127.         &clear;
  128.     }
  129.     elsif ($ch eq "q") {
  130.         last;
  131.     }
  132.     elsif ($ch eq "h") {
  133.         &clear;
  134.         &help;
  135.         &clear;
  136.     }
  137.     else {
  138.         &bell;
  139.     }
  140.     }
  141. }
  142.  
  143. sub defbell {
  144.     eval q#
  145.     sub bell {
  146.         print "\007";
  147.     }
  148.     #;
  149. }
  150.  
  151. sub help {
  152.     local(*lines) = *helplines;
  153.     local($line);
  154.     &pagearray;
  155. }
  156.  
  157. sub inithelp {
  158.     @helplines = split(/\n/,<<'EOT');
  159.  
  160.       Commands marked with * may be preceeded by a number, N.
  161.  
  162.   h              Display this help.
  163.   q              Exit.
  164.  
  165.   f, SPACE    *  Forward  N lines, default one screen.
  166.   b           *  Backward N lines, default one screen.
  167.   e, j, CR    *  Forward  N lines, default 1 line.
  168.   y, k        *  Backward N lines, default 1 line.
  169.   d           *  Forward  N lines, default 10 or last N to d or u command.
  170.   u           *  Backward N lines, default 10 or last N to d or u command.
  171.   r              Repaint screen.
  172.   R              Repaint screen, discarding buffered input.
  173.  
  174.   /pattern    *  Search forward for N-th line containing the pattern.
  175.   ?pattern    *  Search backward for N-th line containing the pattern.
  176.   n           *  Repeat previous search (for N-th occurence).
  177.  
  178.   g           *  Go to line N, default 1.
  179.   G           *  Like g, but default is last line in file.
  180.   p, %        *  Position to N percent into the file.
  181.   m<letter>      Mark the current position with <letter>.
  182.   '<letter>      Return to a previously marked position.
  183.   ''             Return to previous position.
  184.  
  185.   E [file]       Examine a new file.
  186.   N           *  Examine the next file (from the command line).
  187.   P           *  Examine the previous file (from the command line).
  188.   =              Print current file name.
  189.   V              Print version number of "less".
  190.  
  191.   -<flag>        Toggle a command line flag.
  192.   +cmd           Execute the less cmd each time a new file is examined.
  193.  
  194.   !command       Passes the command to a shell to be executed.
  195.   v              Edit the current file with $EDITOR.
  196. EOT
  197.     for (@helplines) {
  198.     s/$/\n/;
  199.     }
  200. }
  201.  
  202. sub percent {
  203.     &standout;
  204.       $percent = int(($line + $lines1) * 100 / @lines);
  205.       &move($lines1,0);
  206.       &addstr("($percent%)");
  207.     &standend;
  208.     &clrtoeol;
  209. }
  210.